home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Best of MacTutor - S…e Code for Volumes 1 to 5
/
The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin
/
Source Code
/
#27 (Dec 87)
/
Pascal MIDI shell
/
MIDIShell.Pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-07-15
|
6KB
|
289 lines
{ Kirk Austin, 7/12/87 }
{ This is an example program that illustrates the following techniques: }
{ My preferred method for handling the about box }
{The use of the transfer command in the file menu }
{The use of the LSPMIDI library including MIDIThru}
PROGRAM ShellExample;
USES
LSPMIDI;
{ Global Constants }
CONST
Null = '';
AppleMenuID = 1;
FileMenuID = 2;
EditMenuID = 3;
MIDIMenuID = 4;
AboutID = 200;
{ Global Variables }
VAR
myMenus : ARRAY[AppleMenuID..MIDIMenuID] OF MenuHandle;
Done : Boolean; { true when user selects quit}
{This is a way to do the about box so that it doesn't interfere with the application.}
{For instance, you can make menu selections while the about box is visible.}
PROCEDURE ShowAbout;
VAR
theDlog : DialogPtr;
oldPort : GrafPtr;
BEGIN
GetPort(oldPort);
theDlog := GetNewDialog(AboutID, NIL, Pointer(-1));
SetPort(theDlog);
DrawDialog(theDlog);
WHILE NOT Button DO
;
DisposDialog(theDlog);
SetPort(oldPort);
END;
PROCEDURE LaunchIt (mode : integer;
VAR fName : Str255);
INLINE
$204F, {movea.l a7,a0 ; (a0) is a ptr to string, 4(a0) is mode}
$A9F2; {_Launch}
PROCEDURE DoXfer;
VAR
where : Point;
reply : SFReply;
vRef : integer;
thefName : Str255;
textType : SFTypeList;
BEGIN
where.h := 80;
where.v := 55;
textType[0] := 'APPL';
SFGetFile(where, Null, NIL, 1, textType, NIL, reply);
WITH reply DO
IF NOT good THEN
thefName := Null
ELSE
BEGIN
thefName := fName;
vRef := vRefNum
END;
IF thefName <> Null THEN
BEGIN
Done := true;
IF SetVol(NIL, vRef) = noErr THEN
BEGIN
ResetSCCA;
ResetSCCB;
QuitTimer;
LaunchIt(0, thefName)
END;
END
END;
PROCEDURE ProcessMenu (codeWord : Longint); { handle menu selections}
VAR
i : integer;
menuNum : Integer;
TheMenuHdle : MenuHandle;
itemNum : Integer;
NameHolder : str255;
dummy : Integer;
ignore : boolean;
TheValue : longint;
BEGIN
IF codeWord <> 0 THEN { nothing was selected}
BEGIN
menuNum := HiWord(codeWord);
itemNum := LoWord(codeWord);
CASE menuNum OF { the different menus}
AppleMenuID :
BEGIN
IF itemNum < 3 THEN
BEGIN
ShowAbout;
END
ELSE
BEGIN
GetItem(myMenus[AppleMenuID], itemNum, NameHolder);
dummy := OpenDeskAcc(NameHolder);
END;
END;
FileMenuID :
BEGIN
CASE ItemNum OF
1 :
BEGIN
DoXfer;
END;
2 :
BEGIN
Done := true;
END;
END;
END;
EditMenuID :
BEGIN
ignore := SystemEdit(itemNum - 1);
END;
MIDIMenuID :
BEGIN
TheMenuHdle := GetMHandle(4);
FOR i := 1 TO 5 DO
CheckItem(TheMenuHdle, i, false);
MIDIThruA(0);
MIDIThruB(0);
CASE ItemNum OF
1 :
BEGIN
CheckItem(TheMenuHdle, 1, true);
MIDIThruA(1);
END;
2 :
BEGIN
CheckItem(TheMenuHdle, 2, true);
MIDIThruA(2);
END;
3 :
BEGIN
CheckItem(TheMenuHdle, 3, true);
MIDIThruB(1);
END;
4 :
BEGIN
CheckItem(TheMenuHdle, 4, true);
MIDIThruB(2);
END;
5 :
BEGIN
CheckItem(TheMenuHdle, 5, true);
MIDIThruA(0);
MIDIThruB(0);
END;
END;
END;
END;
HiliteMenu(0);
END;
END;
{ }
PROCEDURE DealWithMouseDowns (theEvent : EventRecord);
VAR
location : Integer;
windowPointedTo : WindowPtr;
mouseLoc : point;
windowLoc : integer;
VandH : Longint;
Height : Integer;
Width : Integer;
BEGIN
mouseLoc := theEvent.where;
windowLoc := FindWindow(mouseLoc, windowPointedTo);
CASE windowLoc OF
inMenuBar :
BEGIN
ProcessMenu(MenuSelect(mouseLoc));
END;
inSysWindow :
BEGIN
SystemClick(theEvent, windowPointedTo);
END;
OTHERWISE
BEGIN
END;
END;
END;
PROCEDURE DealWithKeyDowns (theEvent : EventRecord);
TYPE
Trick = PACKED RECORD
CASE boolean OF
true : (
long : Longint
);
false : (
chr3, chr2, chr1, chr0 : char
)
END;
VAR
CharCode : char;
TrickVar : Trick;
BEGIN
TrickVar.long := theEvent.message;
CharCode := TrickVar.chr0;
IF BitAnd(theEvent.modifiers, CmdKey) = CmdKey THEN {check for a menu selection}
BEGIN
ProcessMenu(MenuKey(CharCode));
END
END;
PROCEDURE MainEventLoop;
VAR
Event : EventRecord;
ProcessIt : boolean;
x : byte;
TheValue : Longint;
BEGIN
REPEAT
SystemTask;
ProcessIt := GetNextEvent(everyEvent, Event); { get the next event in queue}
IF ProcessIt THEN
BEGIN
CASE Event.what OF
mouseDown :
DealWithMouseDowns(Event);
AutoKey :
DealWithKeyDowns(Event);
KeyDown :
DealWithKeyDowns(Event);
OTHERWISE
BEGIN
END;
END;
END;
UNTIL Done;
END;
PROCEDURE MakeMenus; { get the menus & display them}
VAR
index : Integer;
TheMenuHdle : MenuHandle;
BEGIN
FOR index := AppleMenuID TO MIDIMenuID DO
BEGIN
myMenus[index] := GetMenu(index);
InsertMenu(myMenus[index], 0);
END;
AddResMenu(myMenus[AppleMenuID], 'DRVR');
DrawMenuBar;
{put a check mark on the "none" menu item by default}
TheMenuHdle := GetMHandle(4);
CheckItem(TheMenuHdle, 5, true);
END;
{ Program Starts Here }
BEGIN
Done := false;
FlushEvents(everyEvent, 0);
InitSCCA;
InitSCCB;
InitTimer(782 * 5); {increment the counter every 5 milliseconds}
StartCounter;
MakeMenus;
InitCursor;
MainEventLoop;
ResetSCCA;
ResetSCCB;
QuitTimer;
END.